home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVDMX / SAMPLES.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-20  |  39KB  |  1,269 lines
  1.  
  2. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  3. {                            }
  4. {    SAMPLES   --Multi-window sample demo program    }
  5. {    tvDMX      --data editing project (ver 2.x)    }
  6. {                            }
  7. {    Copyright (c) 1992,94    Randolph Beck        }
  8. {                P.O. Box  56-0487    }
  9. {                Orlando, FL 32856    }
  10. {                CIS:  72361,753        }
  11. {                            }
  12. {■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■}
  13.  
  14. Program SAMPLES;
  15.  
  16. { This program was written to demonstrate various data structures.  You can
  17.   examine the field templates and copy some portions into WORKSHOP.PAS for
  18.   your own experiments.
  19.  
  20.   The design of some of these record structures may seem pointless since
  21.   they are intended only to demonstrate the interface mechanism.
  22.  
  23.   The "Account" window is the simplest example here.  It's somewhat bland,
  24.   but most programmers will only require simple data structures like this.
  25.  
  26.   The "Payroll" window is a larger data window.  It demonstrates the 'Z'
  27.   template code, which forces the display of leading zeroes in that field.
  28.   Its last three fields are marked as READ-ONLY(with the ^R code).  These
  29.   are entered automatically by the virtual methods in object TDmxPayroll,
  30.   which overrides TDmxEditor.  Unlike "Accounts" and "Busy", this window is
  31.   a regular TWindow type.
  32.  
  33.   The "Busy" window uses a more complex template string.  Note the heavy use
  34.   of control codes, and that the last field in the main window is Read-Only.
  35.   One of the integer fields is marked as a "skip" field(that means that the
  36.   cursor will not land on it).
  37.  
  38.   The DateTime type is used here, with fldDATETIME, fldDATE, and fldTIME
  39.   constants --as defined in the DMXGIZMA unit.    Its Year, Month and Day are
  40.   swapped by codes in the fldDATETIME and fldDATE string to place it in its
  41.   more familiar Month-Day-Year order.  An enumerated field is now used for
  42.   the date portion, although its corresponding dialog box does not.
  43.  
  44.  
  45.   Three other views are available from the menu:  "Hex" is a tvDMX-driven
  46.   hex-byte editor using the same data as Busy window;  "Invoice" is the
  47.   tvDMX-shareware invoice converted into a tvDMX form;  and "Dialog" is a
  48.   dialog box that uses tvDMX descendants for individual field input, using
  49.   the data in the current window at the current record.  A dialog window
  50.   may also be actuated by double-clicking a record with a mouse.
  51.  
  52.     It should be noted that the invoice form can be printed and used to
  53.     register for this package, in accordance with the license agreement.
  54.     But previously registered programmers do not need to register again
  55.     for this version.
  56.  
  57.   The data in most windows can be output to a printer or a text file (with
  58.   SAMPLES.OUT as the default), using the objects in unit tvDMXREP.PAS.  The
  59.   cmPrint command in TMyApp.HandleEvent() now prompts first to let the user
  60.   adjust page and destination options before printing.
  61.  
  62.   The dialog box examples are constructed in two different ways.  The dialog
  63.   box for the "Account" data is a regular dialog box with tvDMX InputFields
  64.   from the StdDMX unit.  The "Payroll" and "Busy" data dialog boxes use the
  65.   new EntryBox() function from the DmxForms unit.  (See program FORMSHOP for
  66.   examples of more elaborate forms.)  EntryBox() is similar to the InputBox()
  67.   function in the MsgBox unit, except that it allows for an entire record of
  68.   data to be edited.  And it will scroll on either axis if your form too
  69.   large for the desktop --as is the case with the "Busy" data's form in 25-
  70.   line screen mode.
  71.  
  72.   (See file TVDMXHEX.PAS for the code used in the hexadecimal byte editor.)
  73.  }
  74.  
  75. {$V-,X+ }
  76.  
  77. uses
  78.     Dos, { required to define DateTime type }
  79.     Crt, { required for Sound() procedure used by cmChime command }
  80.     Objects, Drivers, Views, Menus, Dialogs, App, MsgBox,
  81.     RSet, DmxGizma, tvGizma, tvDMX, StdDMX, tvDmxHex, tvDmxRep, DmxForms;
  82.  
  83. const
  84.     cmAbout      =  101;
  85.     cmHasDialog   =  103;
  86.  
  87.     cmAccounts      =  111;
  88.     cmPayroll      =  112;
  89.     cmBusy      =  113;
  90.     cmHex      =  114;
  91.     cmInvoice      =  115;
  92.     cmDialog      =  116;
  93.     cmRecDialog   =  117;
  94.     cmPrint      =  118;
  95.  
  96.     hcDeskTop      = 1100;
  97.     hcAccWin      = 1100;
  98.     hcPayWin      = 1200;
  99.     hcBusyWin      = 1300;
  100.     hcHexWin      = 1400;
  101.     hcInvoiceWin  = 1500;
  102.     hcDialogs      = 4000;
  103.     hcMenus      = 50000;
  104.  
  105.     hcReadOnly      = 1500;
  106.     hcEnumField      = 1501;
  107.  
  108.     hcMain      = hcMenus;
  109.     hcAccounts      = hcMain + 1;
  110.     hcPayroll      = hcMain + 2;
  111.     hcBusy      = hcMain + 3;
  112.     hcHex      = hcMain + 4;
  113.     hcInvoice      = hcMain + 5;
  114.     hcDialog      = hcMain + 6;
  115.     hcPrint      = hcMain + 7;
  116.  
  117.     hcWindow      = hcMain + 10;
  118.     hcUserScr      = hcWindow + 1;
  119.  
  120.     hcOptions      = hcMain + 20;
  121.     hcSound      = hcOptions + 1;
  122.     hcVideo      = hcOptions + 2;
  123.     hcPrnOpt      = hcOptions + 3;
  124.  
  125.  
  126.   { ══ Accounts template and data structure ══════════════════════════════ }
  127.  
  128. const
  129.     AccountLabel : string[80] =
  130.     ' Transaction          Debit        Credit      [?] ';
  131.  
  132.     AccountInfo  : string[80] =
  133.     ' SSSSSSSSSSSSSSSS`SSSSSSSSSS| rrr,rrr.zz  | rrr,rrr.zz  | [x] ';
  134.  
  135.       { Note that the '`' character marks the end of the visible field. }
  136.  
  137. type
  138.     PAccount      = ^TAccount;
  139.     TAccount      =  RECORD
  140.     Account    :  string[26];
  141.     Debit    :  TREALNUM;
  142.     Credit    :  TREALNUM;
  143.     Status    :  boolean;
  144.     end;
  145.  
  146.  
  147.   { ══ Payroll template and data structure ═══════════════════════════════ }
  148.  
  149. const { The last three fields are marked READ-ONLY, and are automatically
  150.     entered by the virtual methods in object TDmxPayroll. }
  151.  
  152.     PayrollLblA  = ' Employee                ID     Earnings       FICA        FITW        SITW   ';
  153.     PayrollInfo  = ' ssssssssssssssssssssss| ZZW ║ $rr,rrr.zz | $r,rrr.zz '^R'| $r,rrr.zz '^R'| $r,rrr.zz '^R;
  154.     PayrollLblB  = ' (dollar amounts are dependent upon Earnings)';
  155.  
  156. type
  157.     PPayroll      = ^TPayroll;
  158.     TPayroll      =  RECORD
  159.     Employee :  string[22];
  160.     ID     :  word;
  161.     Earnings :  TREALNUM;
  162.     FICA     :  TREALNUM;  { READ-ONLY }
  163.     FITW     :  TREALNUM;  { READ-ONLY }
  164.     SITW     :  TREALNUM;  { READ-ONLY }
  165.     end;
  166.  
  167.  
  168.   { ══ Busy data structure ═══════════════════════════════════════════════ }
  169.  
  170. const { The Busy Window's template uses many of the special options.  Since
  171.     it uses an enumerated field, the template is defined in the method
  172.     that instantiates these windows. }
  173.  
  174.     _BusyLabel      =
  175.     ' Name                  SSN             Balance      Start Date   Time   <A>  [B]   Pointer       Value     RO ';
  176.  
  177.     BusyLabel      :  string[length(_BusyLabel)] =  _BusyLabel;
  178.  
  179. type
  180.     PBusyData      = ^TBusyData;
  181.     TBusyData      =  RECORD
  182.     Marker        :  byte;    { HIDDEN field }
  183.     Name        :  string[30];
  184.     SSN        :  string[9];
  185.     realfield1    :  TREALNUM;
  186.     DT        :  datetime;
  187.     intfield0    :  integer;    { READ-ONLY }
  188.     intfield1    :  integer;
  189.     ptrfield    :  pointer;
  190.     realfield2    :  TREALNUM;
  191.     hextwo        :  byte;    { READ-ONLY }
  192.     end;
  193.  
  194.  
  195.   { ══ Invoice data structure ════════════════════════════════════════════ }
  196.  
  197.       { The Invoice Window is a TDmxForm-descendant, so its template uses
  198.     is built by nested NewSItem() calls.  See function InvoiceForm(). }
  199.  
  200. const
  201.     UnitPrice    = 20.00;
  202.     SitePrice    = 50.00;
  203.  
  204.     { bit values for TInvoiceRec.Tools }
  205.     AnsiView    = $0001;
  206.     Blaise    = $0002;
  207.     Btrieve    = $0004;
  208.     PXE        = $0008;
  209.     Topaz    = $0010;
  210.     TPW        = $0020;
  211.     TurboPower    = $0040;
  212.  
  213.     BBS        =   0;
  214.     CIS        =   1;
  215.     Internet    =   2;
  216.     UserGroup    =   3;
  217.     Friend    =   4;
  218.     OtherSource    =   5;
  219.  
  220. type
  221.     TInvoiceRec        = RECORD
  222.     Co,Addr,City,Rep1,Rep2    : string[25];
  223.     ContactA,ContactB    : string[25];
  224.     Quantity        : integer;
  225.     Item            : (Registration, SiteLicense);
  226.     Price,Total        : TREALNUM;
  227.     DiskType        : (disk3p5, disk5p25);
  228.     SendWhen        : (whenrx, whennextver);
  229.      { How long have you been using Turbo Vision? }
  230.     Years,Months        : word;
  231.      { Which version of Borland Pascal are you using? }
  232.     TPversion        : TREALNUM;
  233.      { List any programming tools/add-ins that you use... }
  234.     Tools,WhoSaid        : word;
  235.     BlaiseProd        : string[21];
  236.     SourceName        : string[14];
  237.     TPowerProd        : string[17];
  238.     Others            : array[0..4] of string[44];
  239.     end;
  240.  
  241.  
  242.   { ══════════════════════════════════════════════════════════════════════ }
  243.  
  244.  
  245. type
  246.     PDmxInvoice      = ^TDmxInvoice;
  247.     TDmxInvoice      =  OBJECT(TDmxForm)
  248.       procedure EvaluateField;  VIRTUAL;
  249.       procedure FieldText(var S: string;  var Color: word;
  250.               Field: pDMXfieldrec;  var DataRec );  VIRTUAL;
  251.       function    GetHelpCtx : word;  VIRTUAL;
  252.     end;
  253.  
  254.  
  255.     PDmxEditTbl       = ^TDmxEditTbl;
  256.     PDmxEditTblWin = ^TDmxEditTblWin;
  257.  
  258.  
  259.     TDmxEditTbl     =  OBJECT(TDmxEditor)
  260.       function    GetHelpCtx : word;  VIRTUAL;
  261.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  262.       procedure SetState(AState: word; Enable: boolean);  VIRTUAL;
  263.       function  Valid(Command: word) : boolean;  VIRTUAL;
  264.     end;
  265.  
  266.  
  267.     TDmxEditTblWin  =  OBJECT(TDmxWindow)
  268.       procedure InitDMX(ATemplate: string;  var AData;
  269.             ALabels,ARecInd: PDmxLink;
  270.             BSize: longint);  VIRTUAL;
  271.     end;
  272.  
  273.  
  274.     PDmxPayroll    = ^TDmxPayroll;
  275.  
  276.     TDmxPayroll       =  OBJECT(TDmxEditTbl)
  277.       procedure EvaluateField;    VIRTUAL;
  278.       procedure ZeroizeField(Whole: boolean; Field: pDMXfieldrec);  VIRTUAL;
  279.       procedure RecalcRecord;
  280.     end;
  281.  
  282.  
  283.     PMyStatusLine  = ^TMyStatusLine;
  284.     TMyStatusLine  =  OBJECT(TStatusLine)
  285.       function    Hint(AHelpCtx: word) : string;  VIRTUAL;
  286.     end;
  287.  
  288.  
  289.     TAppN       =  OBJECT(TAppPrn)  { from tvDMXREP.PAS }
  290.     end;
  291.  
  292.     TMyApp       =  OBJECT(TAppN)
  293.       constructor Init;
  294.       procedure Idle;  VIRTUAL;
  295.       procedure HandleEvent(var Event: TEvent);  VIRTUAL;
  296.       procedure InitMenuBar;     VIRTUAL;
  297.       procedure InitStatusLine;  VIRTUAL;
  298.       procedure AccountWindow;
  299.       procedure PayrollWindow;
  300.       procedure BusyWindow;
  301.       procedure HexWindow;
  302.       procedure InvoiceFormWin;
  303.       procedure AccountDialog(P: PDmxEditTbl);
  304.       procedure PayrollDialog(P: PDmxPayroll);
  305.       procedure BusyDialog(P: PDmxEditTbl);
  306.     end;
  307.  
  308.  
  309. const
  310.     MaxRecordNum  =   49;
  311.  
  312. var
  313.     Accounts    :  array[0..MaxRecordNum] of TAccount;
  314.     Payroll    :  array[0..MaxRecordNum] of TPayroll;
  315.     BusyData    :  array[0..MaxRecordNum] of TBusyData;
  316.     InvoiceRec    :  TInvoiceRec;
  317.  
  318.  
  319.   procedure InitializeData;  forward;  { for the sample data }
  320.  
  321.  
  322.   { ══ TMyStatusLine ═════════════════════════════════════════════════════ }
  323.  
  324.  
  325. function  TMyStatusLine.Hint(AHelpCtx: word) : string;
  326. begin
  327.   Case AHelpCtx of
  328.     hcDragging:   Hint := #24#25#26#27' Move  Shift-'#24#25#26#27' Resize  '#17#196#217' Done  Esc Cancel';
  329.     hcReadOnly:   Hint := '(Read-Only field)';
  330.     hcEnumField:  Hint := '(Use "+" or "-")';
  331.  
  332.     hcAccWin:      Hint := '';
  333.     hcPayWin:      Hint := '';
  334.     hcBusyWin:      Hint := '';
  335.     hcHexWin:      Hint := '';
  336.     hcInvoiceWin: Hint := '';
  337.     hcDialogs:      Hint := '';
  338.  
  339.     hcMain:      Hint := 'Demonstration window selections';
  340.     hcAccounts:   Hint := 'Demo of simple data structure';
  341.     hcPayroll:      Hint := 'Demo of read-only fields which are entered by virtual methods';
  342.     hcBusy:      Hint := 'Demo of complex date fields, hidden fields, and a "skip" field';
  343.     hcHex:      Hint := 'Hex editor using the same data as the Busy window';
  344.     hcInvoice:      Hint := 'Demo form window using a descendant of object TDmxForm';
  345.     hcDialog:      Hint := 'Open a dialog box for the current record';
  346.     hcPrint:      Hint := 'Print data in the current window (set destination in Options menu)';
  347.  
  348.     hcWindow:      Hint := 'Arrange and manipulate windows';
  349.     hcUserScr:      Hint := 'Display the original user screen';
  350.  
  351.     hcOptions:      Hint := 'Sound, video and printer options';
  352.     hcSound:      Hint := 'Toggle sound on/off';
  353.     hcVideo:      Hint := 'Toggle video mode';
  354.     hcPrnOpt:      Hint := 'Change printer/output destination and parameters';
  355.  
  356.    else          Hint := StdMenuHint(AHelpCtx);  { from tvGIZMA.PAS }
  357.     end;
  358. end;
  359.  
  360.  
  361.   { ══════════════════════════════════════════════════════════════════════ }
  362.  
  363.  
  364. function  InvoiceForm : PSItem;
  365. { The labels are enclosed by tilde ('~') symbols, and
  366.   the '\' delimiter is used to separate text from literals. }
  367.  
  368.     function  Heading(Next: PSItem) : PSItem;
  369.     begin
  370.       Heading :=
  371.     NewSItem('~  Remit to:                                 From:~',
  372.     NewSItem('',
  373.     NewSItem('~    Randolph Beck                            ~\sssssssssssssssssssssssss\ ',
  374.     NewSItem('~    P.O. Box  56-0487                        ~\sssssssssssssssssssssssss',
  375.     NewSItem('~    Orlando, FL 32856                        ~\sssssssssssssssssssssssss',
  376.     NewSItem('~    CIS: 72361,753                           ~\sssssssssssssssssssssssss',
  377.     NewSItem('~                                             ~\sssssssssssssssssssssssss',
  378.     NewSItem('',
  379.     NewSItem('~                ░░░░░   ░░     ░░ ░░   ░░~',
  380.     NewSItem('~   ░░            ░░ ░░  ░░░   ░░░  ░░ ░░    Contact individual:~',
  381.     NewSItem('~  ░░░░░ ░░   ░░  ░░  ░░ ░░░░ ░░░░   ░░░      ~\sssssssssssssssssssssssss',
  382.     NewSItem('~   ░░    ░░ ░░   ░░  ░░ ░░ ░░░ ░░   ░░░      ~\sssssssssssssssssssssssss',
  383.     NewSItem('~   ░░     ░░░    ░░  ░░ ░░  ░  ░░  ░░ ░░~',
  384.     NewSItem('~    ░░     ░    ░░░░░░  ░░     ░░ ░░   ░░~',
  385.         Next))))))))))))));
  386.     end;
  387.  
  388.     function  Information(Next: PSItem) : PSItem;
  389.     begin
  390.       Information :=
  391.     NewSItem('~             Qty                          Unit Price~',
  392.     NewSItem('',
  393.     NewSItem('           \IIII \'
  394.         + InitEnumField(TRUE, accReadOnly + accSkip, 0,
  395.             NewSItem(' tvDMX Registration ',
  396.             NewSItem(' tvDMX Site License ',
  397.                 nil)))                 + '    \ $RRR.ZZ '^S^R,
  398.     NewSItem('',
  399.     NewSItem('~                                   Total  ~\ $RRR.ZZ '^R,
  400.     NewSItem('',
  401.     NewSItem('',
  402.     NewSItem('~  I prefer ~'
  403.         + InitEnumField(TRUE, accNormal, 0,
  404.             NewSItem('3 1/2"',
  405.             NewSItem('5 1/4"',
  406.                 nil))) + '~ disks.~',
  407.         Next))))))));
  408.     end;
  409.  
  410.     function  Instructions(Next: PSItem) : PSItem;
  411.     begin
  412.       Instructions :=
  413.     NewSItem('~  Note that the tvDMX toolkit has been delivered and accepted by~',
  414.     NewSItem('~  the customer.  A current disk, including full documentation and~',
  415.     NewSItem('~  more units, will be sent ~'
  416.         + InitEnumField(TRUE, accNormal, 0,
  417.             NewSItem('when the next update is available.',
  418.             NewSItem('upon receipt of this paid invoice.',
  419.                 nil))),
  420.         Next)));
  421.     end;
  422.  
  423.     function  ClientInfo(ANext: PSItem) : PSItem;
  424.     begin
  425.       ClientInfo :=
  426.     NewSItem('~  Client Information (Optional)~',
  427.     NewSItem('~  ══════════════════~',
  428.     NewSItem('',
  429.     NewSItem('~    How long have you been using Turbo Vision?~\ W '#0'~years ~\WW '^U#11#0'~months~',
  430.     NewSItem('',
  431.     NewSItem('~    Which version of Turbo Pascal are you using?~\RR.ZR',
  432.     NewSItem('',
  433.     NewSItem('~    List tools that you use:           Where did you find tvDMX?~',
  434.     NewSItem('   \ [KA]~ AnsiView                     ~\ (kB)~ BBS                  ~',
  435.     NewSItem('   \ [KA]~ Blaise:~\sssssssssssssssssssss\ (kB)~ CompuServe           ~',
  436.     NewSItem('   \ [KA]~ Btrieve                      ~\ (kB)~ Internet             ~',
  437.     NewSItem('   \ [KA]~ Paradox Engine               ~\ (kB)~ User group           ~',
  438.     NewSItem('   \ [KA]~ Topaz                        ~\ (kB)~ friend or collegue   ~',
  439.     NewSItem('   \ [KA]~ Turbo Pascal for Windows     ~\ (kB)~ Other:~\ssssssssssssss',
  440.     NewSItem('   \ [KA]~ TurboPower:~\sssssssssssssssss',
  441.     NewSItem('',
  442.     NewSItem('~     Others:~\ssssssssssssssssssssssssssssssssssssssssssss',
  443.     NewSItem('~            ~\ssssssssssssssssssssssssssssssssssssssssssss',
  444.     NewSItem('~            ~\ssssssssssssssssssssssssssssssssssssssssssss',
  445.         ANext)))))))))))))))))));
  446.     end;
  447.  
  448. begin
  449.   InvoiceForm := NewSItem(^A,
  450.     Heading(
  451.     NewSItem('',
  452.     NewSItem('',
  453.     Information(
  454.     NewSItem('',
  455.     Instructions(
  456.     NewSItem('',
  457.     NewSItem('',
  458.     NewSItem('',
  459.     ClientInfo(
  460.     NewSItem('',
  461.         nil))))))))))));
  462. end;
  463.  
  464.  
  465.   { ══ TDmxInvoice ═══════════════════════════════════════════════════════ }
  466.  
  467.  
  468. procedure TDmxInvoice.EvaluateField;
  469. begin
  470.   TDmxForm.EvaluateField;
  471.   If FieldAltered and (CurrentField^.typecode = 'I') then
  472.     With InvoiceRec do
  473.       begin
  474.      { tvDMX goes for $20.00 each registration (const ToolPrice)
  475.            or $50.00 for a site license (const SitePrice).
  476.        This method calculates the proper payment.
  477.       }
  478.       If (Quantity <= 2) then
  479.     begin
  480.     Price := UnitPrice;
  481.     Total := Quantity * UnitPrice;
  482.     Item  := Registration;
  483.     end
  484.        else
  485.     begin
  486.     Price := SitePrice;
  487.     Total := Price;
  488.     Item  := SiteLicense;
  489.     end;
  490.       DrawView;
  491.       end;
  492. end;
  493.  
  494.  
  495. procedure TDmxInvoice.FieldText(var S: string; var Color: word;
  496.                 Field: pDMXfieldrec;  var DataRec );
  497. var  i : integer;
  498.      P : pchar;
  499. begin
  500.   TDmxForm.FieldText(S, Color, Field, DataRec);
  501.   If (upcase(Field^.typecode) in ['S','#','C','0']) and (Field^.fieldsize > 0) then
  502.     begin
  503.     P := @DataRec;
  504.     Inc(PtrRec(P).Ofs, Field^.datatab);
  505.     If (Color > 0) and ((P^ = #0) or DrawingField) then
  506.       For i := 1 to length(S) do
  507.     If (S[i] = ' ') and (Field^.template^[i] = #0) then S[i] := '_';
  508.     end;
  509. end;
  510.  
  511.  
  512. function  TDmxInvoice.GetHelpCtx : word;
  513. begin
  514.   If (CurrentField^.typecode = fldENUM) then
  515.     GetHelpCtx := hcEnumField
  516.   else
  517.   If (CurrentField^.access and accReadOnly <> 0) then
  518.     GetHelpCtx := hcReadOnly
  519.   else
  520.     GetHelpCtx := HelpCtx;
  521. end;
  522.  
  523.  
  524.   { ══ TDmxEditTbl ═══════════════════════════════════════════════════════ }
  525.  
  526.  
  527. function  TDmxEditTbl.GetHelpCtx : word;
  528. begin
  529.   If (CurrentField^.typecode = fldENUM) then
  530.     GetHelpCtx := hcEnumField
  531.   else
  532.   If (CurrentField^.access and accReadOnly <> 0) then
  533.     GetHelpCtx := hcReadOnly
  534.   else
  535.     GetHelpCtx := HelpCtx;
  536. end;
  537.  
  538.  
  539. procedure TDmxEditTbl.HandleEvent(var Event: TEvent);
  540. begin
  541.   TDmxEditor.HandleEvent(Event);
  542.   With Event do
  543.     If (What = evCommand) then
  544.       begin
  545.       Case Command of
  546.     cmDialog,cmDMX_DoubleClick:
  547.       Message(Application, evCommand, cmRecDialog, @Self);
  548.     cmHasDialog:
  549.       begin end;  { just allow this event to clear }
  550.        else    Exit;
  551.     end;
  552.       ClearEvent(Event);
  553.       end;
  554. end;
  555.  
  556.  
  557. procedure TDmxEditTbl.SetState(AState: word; Enable: boolean);
  558. begin
  559.   TDmxEditor.SetState(AState, Enable);
  560.   If (AState and sfActive <> 0) then
  561.     begin
  562.     If Enable then EnableCommands([cmDialog]) else DisableCommands([cmDialog]);
  563.     end;
  564. end;
  565.  
  566.  
  567. function  TDmxEditTbl.Valid(Command: word) : boolean;
  568. var  V    : boolean;
  569. begin
  570.   V := TDmxEditor.Valid(Command);
  571.   If not V and
  572.     ((Command = cmDMX_ZeroizeField) or (Command = cmDMX_ZeroizeRecord))
  573.    then
  574.     If (MessageBox('Records has READ-ONLY fields.'^M
  575.          + 'Should a partial erase be performed?',
  576.         nil, mfError or mfYesButton or mfNoButton) = cmYes) then V := TRUE;
  577.   Valid := V;
  578. end;
  579.  
  580.  
  581.   { ══ TDmxEditTblWin ════════════════════════════════════════════════════ }
  582.  
  583.  
  584. procedure TDmxEditTblWin.InitDMX(ATemplate: string;  var AData;
  585.                   ALabels,ARecInd: PDmxLink;
  586.                   BSize: longint);
  587. { To override TDmxEditor (as does object TDmxEditTbl above), you could
  588.   override a TDmxWindow object to insert the new object.  This window
  589.   type is used for the "Accounts" and "Busy" windows.  (The "Payroll"
  590.   window uses a regular TWindow type.)
  591.  }
  592. var  R    : TRect;
  593. begin
  594.   GetExtent(R);
  595.   R.Grow(-1,-1);
  596.   If ALabels <> nil then Inc(R.A.Y, ALabels^.Size.Y);
  597.   DMX := New(PDmxEditTbl, Init(ATemplate, AData, BSize, R,
  598.         ALabels, ARecInd,
  599.         StandardScrollBar(sbHorizontal),
  600.         StandardScrollBar(sbVertical)));
  601.   Insert(DMX);
  602. end;
  603.  
  604.  
  605.   { ══ TDmxPayroll ═══════════════════════════════════════════════════════ }
  606.  
  607.  
  608. procedure TDmxPayroll.EvaluateField;
  609. { virtual method called after a field is edited...
  610.   -- It updates the three READ-ONLY fields when field 3 is modified.
  611.  }
  612. begin
  613.   TDmxEditTbl.EvaluateField;
  614.   If (CurrentField^.fieldnum = 3) and FieldAltered then RecalcRecord;
  615. end;
  616.  
  617.  
  618. procedure TDmxPayroll.ZeroizeField(Whole: boolean; Field: pDMXfieldrec);
  619. { virtual method called to clear a field...
  620.   -- The program will still operate properly without overriding this method,
  621.      but the READ-ONLY fields would not react until the user changes fields.
  622.  }
  623. begin
  624.   TDmxEditTbl.ZeroizeField(Whole, Field);
  625.   If (Field^.fieldnum = 3) then RecalcRecord;
  626. end;
  627.  
  628.  
  629. procedure TDmxPayroll.RecalcRecord;
  630. { new method to follow up on changes }
  631. begin
  632.   With Payroll[CurrentRecord] do
  633.     begin
  634.     FICA  := Earnings * 0.075;
  635.     FITW  := Earnings * 0.28;
  636.     SITW  := Earnings * 0.05;
  637.     end;
  638.   RedrawRecord := TRUE;  { forces entire record to be redrawn }
  639. end;
  640.  
  641.  
  642.   { ══ TMyApp ════════════════════════════════════════════════════════════ }
  643.  
  644.  
  645. constructor TMyApp.Init;
  646. begin
  647.   TAppN.Init;
  648.   MenuBar^.HelpCtx := hcMenus;
  649.   DeskTop^.HelpCtx := hcDeskTop;
  650.   hcEntryBox       := hcDialogs;
  651.   InitializeData;  { initialize the sample data }
  652.  
  653.   { Open the first 5 selections }
  654.   AccountWindow;
  655.   PayrollWindow;
  656.   BusyWindow;
  657.   HexWindow;
  658.   InvoiceFormWin;
  659.  
  660.   DeskTop^.SelectNext(FALSE);  { change back to account window }
  661.  
  662.   Message(Application, evCommand, cmAbout, @Self);
  663.  
  664. end;
  665.  
  666.  
  667. procedure TMyApp.Idle;
  668. begin
  669.   TAppN.Idle;
  670.   If (Message(DeskTop, evCommand, cmDMX_RollCall, @Self) <> nil) then
  671.     EnableCommands([cmPrint])
  672.    else
  673.     DisableCommands([cmPrint]);
  674. end;
  675.  
  676.  
  677. procedure TMyApp.HandleEvent(var Event: TEvent);
  678.  
  679.     procedure About;
  680.     const AIntro = ^C'tvDMX Demo'^M^M
  681.          + ^C'Copyright (c) 1994'^M
  682.          + ^C'Randolph Beck'^M;
  683.     {$IFDEF DPMI }
  684.       AVStr     = 'Protected';
  685.     {$ELSE }
  686.       AVStr     = 'Real';
  687.     {$ENDIF }
  688.      Intro    : string[length(AIntro)] = AIntro;
  689.      VStr    : string[length(AVStr)]     = AVStr;
  690.     var     R    : TRect;
  691.      Dialog    : PDialog;
  692.      S    : string;
  693.     begin
  694.       R.Assign(0, 0, 41, 13);
  695.       Dialog := New(PDialog, Init(R, 'About'));
  696.       With Dialog^ do
  697.     begin
  698.     Options := Options or ofCentered;
  699.     R.Grow(-1,-2);
  700.     FormatStr(S, '%s'^M^C'Memory available: %d'^M^C'[%s mode]',
  701.         sparam(@Intro,
  702.         dparam(MemAvail,
  703.         sparam(@VStr,
  704.             nil)))^
  705.         );
  706.     Insert(New(PStaticText, Init(R, S)));
  707.     R.Assign(16, 10, 26, 12);
  708.     Insert(New(PButton, Init(R, 'O~K~', cmOK, bfDefault)));
  709.     HelpCtx := hcDialogs;
  710.     end;
  711.       ExecView(Dialog);
  712.       Dispose(Dialog, Done);
  713.     end;
  714.  
  715.     procedure DoChime;
  716.     begin
  717.       If BeepOn then
  718.     begin
  719.     Sound(1047);
  720.     Delay(50);
  721.     If (Event.InfoPtr = nil) or (PTimeView(Event.InfoPtr)^.Min = 0) then
  722.       begin
  723.       NoSound;
  724.       Delay(50);
  725.       Sound(2094);
  726.       end
  727.      else
  728.       Sound(523);
  729.     Delay(100);
  730.     NoSound;
  731.     end;
  732.     end;
  733.  
  734.     procedure DoRecDialog;
  735.     var  P : PDmxEditTbl;
  736.     begin
  737.       P := Event.InfoPtr;
  738.       If (P <> nil) then
  739.     begin
  740.     If (P^.WorkingData = @Accounts) then AccountDialog(P)
  741.     else
  742.     If (P^.WorkingData = @Payroll)    then PayrollDialog(PDmxPayroll(P))
  743.     else
  744.     If (P^.WorkingData = @BusyData) then BusyDialog(P);
  745.     end;
  746.     end;
  747.  
  748.     procedure PrintPageTop;
  749.     var  S : string;
  750.     begin
  751.       S := PWindow(PDmxReport(Event.InfoPtr)^.DMX^.Owner)^.Title^;
  752.       PDmxReport(Event.InfoPtr)^.PrintLn(S);  { prints window title }
  753.     end;
  754.  
  755.     procedure PrintPageEnd;
  756.     begin
  757.       With PDmxReport(Event.InfoPtr)^ do
  758.     If (succ(pred(LastRecord) div PageSize) > 1) then
  759.       PrnPageEnd(Event)
  760.      else
  761.       PDmxReport(Event.InfoPtr)^.PrintLn('tvDMX 2.5');
  762.     end;
  763.  
  764. begin
  765.   TAppN.HandleEvent(Event);
  766.   If (Event.What and evMessage <> 0) then
  767.     begin
  768.     Case Event.Command of
  769.       cmAbout:        About;
  770.       cmAccounts:    AccountWindow;
  771.       cmPayroll:    PayrollWindow;
  772.       cmBusy:        BusyWindow;
  773.       cmHex:        HexWindow;
  774.       cmInvoice:    InvoiceFormWin;
  775.       cmRecDialog:    DoRecDialog;
  776.       cmChime:        DoChime;
  777.       cmPrint:        If PrnSetOptions(hcDialogs,hcDialogs,hcDialogs) = cmOK
  778.              then PrnCurrentDMX;
  779.       cmPRN_SetOptions:    PrnSetOptions(hcDialogs,hcDialogs,hcDialogs);
  780.       cmPRN_NewPage:    PrintPageTop;
  781.       cmPRN_EndPage:    PrintPageEnd;
  782.      else
  783.       Exit;
  784.       end;
  785.     If (Event.What = evCommand) then ClearEvent(Event);
  786.     end;
  787. end;
  788.  
  789.  
  790. procedure TMyApp.InitMenuBar;
  791. var  R: TRect;
  792. begin
  793.   GetExtent(R);
  794.   R.B.Y := R.A.Y + 1;
  795.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  796.     NewSubMenu('~S~amples', hcMain, NewMenu(
  797.       NewItem('~A~ccounts', '',    kbNoKey, cmAccounts,hcAccounts,
  798.       NewItem('Pa~y~roll',  '',    kbNoKey, cmPayroll, hcPayroll,
  799.       NewItem('~B~usy',     'F4',  kbF4,    cmBusy,    hcBusy,
  800.       NewItem('~H~ex',        '',    kbNoKey, cmHex,     hcHex,
  801.       NewItem('~I~nvoice',  '',    kbNoKey, cmInvoice, hcInvoice,
  802.       NewLine(
  803.       NewItem('~P~rint',    'F9',  kbF9,    cmPrint,   hcPrint,
  804.       NewItem('~D~ialog',   'F2',  kbF2,    cmDialog,  hcDialog,
  805.       NewLine(
  806.       NewItem('e~X~it',   'Alt-X', kbAltX,  cmQuit,    hcExit,
  807.       nil))))))))))),
  808.     NewSubMenu('~W~indow', hcWindow, NewMenu(
  809.       NewItem('~S~ize/Move', 'Ctrl-F5', kbCtrlF5, cmResize, hcResize,
  810.       NewItem('~Z~oom',      'F5',  kbF5,    cmZoom,    hcZoom,
  811.       NewItem('~T~ile',      '',    kbNoKey, cmTile,    hcTile,
  812.       NewItem('C~a~scade',   '',    kbNoKey, cmCascade, hcCascade,
  813.       NewItem('~N~ext',      'F6',  kbF6,    cmNext,    hcNext,
  814.       NewItem('~P~revious',  'Shift-F6', kbShiftF6, cmPrev, hcPrev,
  815.       NewItem('~C~lose', 'Alt-F3',  kbAltF3, cmClose,    hcClose,
  816.       NewLine(
  817.       NewItem('~U~ser screen', 'Alt-F5',  kbAltF5, cmUserScreen, hcUserScr,
  818.       nil)))))))))),
  819.     NewSubMenu('~O~ptions', hcOptions, NewMenu(
  820.       NewSoundItem(hcSound,
  821.       NewVideoItem(hcVideo,
  822.       NewItem('~P~rint options...','', kbNoKey, cmPRN_SetOptions, hcPrnOpt,
  823.       nil)))),
  824.     nil)
  825.   )))));
  826. end;
  827.  
  828.  
  829. procedure TMyApp.InitStatusLine;
  830. var  R:    TRect;
  831. begin
  832.   GetExtent(R);
  833.   R.A.Y := R.B.Y - 1;
  834.   StatusLine := New(PMyStatusLine, Init(R,
  835.     NewStatusDef(hcNoContext, hcDeskTop - 1,
  836.       NewStatusKey('tvDMX',        kbNoKey,cmAbout,
  837.       nil),
  838.     NewStatusDef(hcDeskTop, hcDialogs - 1,
  839.       NewStatusKey('tv~DMX~  ',    kbNoKey,cmAbout,
  840.       NewStatusKey('~F2~ Dialog',    kbF2,    cmDialog,
  841.       NewStatusKey('~F5~ Zoom',    kbF5,    cmZoom,
  842.       NewStatusKey('~F6~ Next',    kbF6,    cmNext,
  843.       NewStatusKey('~F9~ Print',    kbF9,    cmPrint,
  844.       NewStatusKey('~F10~ Menu',    kbF10,    cmMenu,
  845.       nil)))))),
  846.     NewStatusDef(hcDialogs, hcMenus - 1,
  847.       NewStatusKey('~Esc~ Cancel',    kbEsc,    cmCancel,
  848.       nil),
  849.     NewStatusDef(hcMenus, $FFFF,
  850.       NewStatusKey('tv~DMX~',        kbNoKey,cmAbout,
  851.       nil),
  852.     nil))))
  853.   ));
  854. end;
  855.  
  856.  
  857. procedure TMyApp.AccountWindow;
  858. var  R    : TRect;
  859.      W    : PDmxWindow;
  860. begin
  861.   AssignWinRect(R, length(AccountLabel) + 2, 0);
  862.   W := New(PDmxEditTblWin, Init(R,    { window rectangle }
  863.         'Accounts',        { window title }
  864.         wnNextAvail,        { window number }
  865.         AccountInfo,        { template string }
  866.         Accounts,        { data records }
  867.         sizeof(Accounts),    { data size }
  868.         AccountLabel,        { heading label }
  869.         7));            { indicator width }
  870.   W^.HelpCtx := hcAccWin;
  871.   DeskTop^.Insert(ValidView(W));
  872. end;
  873.  
  874.  
  875. procedure TMyApp.PayrollWindow;
  876. var  R     : TRect;
  877.      DMX : PDmxPayroll;
  878.      W     : PWindow;
  879. begin
  880.   AssignWinRect(R, length(PayrollLblA) + 2, 0);
  881.   New(W, Init(R, 'Payroll', wnNextAvail));
  882.   With W^ do
  883.     begin
  884.     Options := Options or ofTileable;
  885.     HelpCtx := hcPayWin;
  886.     GetExtent(R);
  887.     R.Grow(-1,-3);        { adjust R for border and labels }
  888.     New(DMX, Init(PayrollInfo,    { template string }
  889.         Payroll,        { data records }
  890.         sizeof(Payroll),    { data size }
  891.         R,            { view rectangle }
  892.         New(PDmxFLabels, InitInsert(W, PayrollLblA)),
  893.         New(PDmxRecInd,  InitInsert(W, 7)),
  894.         StandardScrollBar(sbHorizontal),
  895.         StandardScrollBar(sbVertical))
  896.      );
  897.     Insert(DMX);
  898.     R.Assign(1, Size.Y - 3, pred(Size.X), Size.Y - 1);
  899.     Insert(New(PDmxFLabels, Init(PayrollLblB, R)));
  900.     end;
  901.   DeskTop^.Insert(ValidView(W));
  902. end;
  903.  
  904.  
  905. procedure TMyApp.BusyWindow;
  906. var  R    : TRect;
  907.      W    : PDmxWindow;
  908.      BusyInfo : string;
  909.  
  910.     function  fldEnumDATE : string;
  911.     begin
  912.       fldEnumDATE :=  ^F + ^P+char(2) +
  913.     InitEnumField(TRUE, 0,0,
  914.         NewSItem('  0?-',
  915.         NewSItem(' Jan-',
  916.         NewSItem(' Feb-',
  917.         NewSItem(' Mar-',
  918.         NewSItem(' Apr-',
  919.         NewSItem(' May-',
  920.         NewSItem(' Jun-',
  921.         NewSItem(' Jul-',
  922.         NewSItem(' Aug-',
  923.         NewSItem(' Sep-',
  924.         NewSItem(' Oct-',
  925.         NewSItem(' Nov-',
  926.         NewSItem(' Dec-',
  927.         NewSItem(' ERR-',
  928.         nil))))))))))))))
  929.     ) + ^H'B' +  { hide the upper byte of the month's WORD field }
  930.     #0'ZW-'^Z + ^U+char(31) +
  931.     #0'ZZZW '^Z^F + ^P+char(-6) +
  932.     #0 + ^P+char(4);
  933.     end;
  934.  
  935. begin
  936.   BusyInfo    := 'B' + ^H        { hidden byte field }
  937.          + #0' ssssssssssssssssssss`ssssssssss'  { Name field }
  938.          + '| ###-##-#### '    { string of numerics only }
  939.          + '|($rrr,rrr.zz)'    { positive or negative currency }
  940.  
  941.         { DateTime type: }
  942.          + '|' + fldEnumDATE
  943.          + #0  + fldTIME    { constant defined in DMXGIZMA.PAS }
  944.  
  945.          + '|iii ' + ^Z^R^S    { showzeroes/readonly/skip }
  946.          + '\iii '        { normal integer }
  947.          + '| HHHH:HHHH '    { hex longint value }
  948.          + '|RRR,RRR.RRR '    { positive values only }
  949.          + '| hh ' + ^Z^R;    { showzeroes/readonly field }
  950.  
  951.   AssignWinRect(R, length(BusyLabel) + 2, 0);
  952.   W := New(PDmxEditTblWin, Init(R,    { window rectangle }
  953.         'Busy Window',        { window title }
  954.         wnNextAvail,        { window number }
  955.         BusyInfo,        { template string }
  956.         BusyData,        { data records }
  957.         sizeof(BusyData),    { data size }
  958.         BusyLabel,        { heading label }
  959.         10));            { indicator width }
  960.   W^.HelpCtx := hcBusyWin;
  961.   DeskTop^.Insert(ValidView(W));
  962. end;
  963.  
  964.  
  965. procedure TMyApp.HexWindow;
  966. { uses objects in file tvDMXHEX.PAS }
  967. var  R    : TRect;
  968.      W    : PDmxWindow;
  969. begin
  970.   AssignWinRect(R, length(HexLabels) + 2, 0);
  971.   W := New(PDmxHexWin, Init(R, 'Hex Window', wnNextAvail,
  972.                   BusyData, sizeof(BusyData)));
  973.   W^.HelpCtx := hcHexWin;
  974.   DeskTop^.Insert(ValidView(W));
  975. end;
  976.  
  977.  
  978. procedure TMyApp.InvoiceFormWin;
  979. var  R    : TRect;
  980.      W    : PWindow;
  981.      DMX: PDmxInvoice;
  982.      Templates: PSItem;
  983. begin
  984.   Templates := InvoiceForm;
  985.   AssignWinRect(R, 0,0);  { assign window dimensions }
  986.   New(W, Init(R, 'INVOICE', wnNextAvail));
  987.   With W^ do
  988.     begin
  989.     Options := Options or ofTileable; { must be tileable for AssignWinRect }
  990.     GetExtent(R);          { create new rectangle for editor object }
  991.     R.Grow(-1,-1);                  { shrink -1 to avoid borders }
  992.     New(DMX, Init(Templates,                   { template list }
  993.         TRUE,                   { alternate key control }
  994.         InvoiceRec,                         { record data }
  995.         R,                        { view's rectangle }
  996.         nil,nil,
  997.         StandardScrollBar(sbHorizontal),
  998.         StandardScrollBar(sbVertical))
  999.     );
  1000.     DMX^.HelpCtx := hcDesktop;
  1001.     Insert(DMX);
  1002.     end;
  1003.   DeskTop^.Insert(ValidView(W));
  1004.   DisposeSItems(Templates);  { not needed after initialization }
  1005. end;
  1006.  
  1007.  
  1008. procedure TMyApp.AccountDialog(P: PDmxEditTbl);
  1009. var  R         : TRect;
  1010.      Dialog  : PDialog;
  1011.      B         : PButton;
  1012.      A         : string;
  1013.      Control : word;
  1014. begin
  1015.   Str(succ(P^.CurrentRecord), A);
  1016.   DeskTop^.GetExtent(R);
  1017.   Dialog := New(PDialog, Init(R, 'Account Record #' + A));
  1018.   If (Dialog <> nil) then
  1019.     begin
  1020.     With Dialog^ do
  1021.       begin
  1022.       HelpCtx  := hcDialogs;
  1023.       InsertField(Dialog, 5,2, TRUE,  ' ~T~ransaction', ' SSSSSSSSSSSSSSSSSSSSSSSSSS');
  1024.       InsertField(Dialog, 2,5, TRUE,  '    ~D~ebit        Credit', ' rrr,rrr.zz  \ rrr,rrr.zz  ');
  1025.       InsertField(Dialog, 6,8, FALSE, '~S~tatus: ', '~[Cleared]~'^X);
  1026.       R.Assign(0, 10, 10, 12);
  1027.       B := New(PButton, Init(R, 'O~K~', cmOK, bfDefault));
  1028.       B^.Options := B^.Options or ofCenterX;
  1029.       Insert(B);
  1030.       SelectNext(FALSE);
  1031.       SetData(Accounts[P^.CurrentRecord]);
  1032.       end;
  1033.     TrimDialog(Dialog);
  1034.     Control := DeskTop^.ExecView(Dialog);
  1035.     If (Control = cmOK) then
  1036.       begin
  1037.       { return record to table }
  1038.       Dialog^.GetData(Accounts[P^.CurrentRecord]);
  1039.       { redraw all windows that use Accounts }
  1040.       Message(DeskTop, evBroadcast, cmDMX_DrawData, @Accounts);
  1041.       end;
  1042.     Dispose(Dialog, Done);
  1043.     end;
  1044. end;
  1045.  
  1046.  
  1047. procedure TMyApp.PayrollDialog(P: PDmxPayroll);
  1048. var  A    : string;
  1049. begin
  1050.   Str(succ(P^.CurrentRecord), A);
  1051.   If (EntryBox('Employee Record #'+A, P^.RecordData, mfOKCancel,
  1052.     NewSItem(^A,
  1053.     NewSItem('~      Name~',
  1054.     NewSItem('~    ~\ ssssssssssssssssssssss'#0'▄  ',
  1055.     NewSItem('~      ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀~',
  1056.     NewSItem('~      ID Number: ~\ ZZW '#0'▄ ',
  1057.     NewSItem('~                   ▀▀▀▀▀~',
  1058.     NewSItem('~      Earnings:~\ $rr,rrr.zz ' + #0'▄ '#0'r'^H#0'r'^H#0'r'^H,
  1059.     NewSItem('~                 ▀▀▀▀▀▀▀▀▀▀▀▀~',
  1060.          nil))))))))
  1061.     ) = cmOK)
  1062.     then
  1063.       begin
  1064.       P^.RecalcRecord;
  1065.       Message(DeskTop, evBroadcast, cmDMX_DrawData, @Payroll);
  1066.       end;
  1067. end;
  1068.  
  1069.  
  1070. procedure TMyApp.BusyDialog(P: PDmxEditTbl);
  1071. var  A    : string;
  1072. begin
  1073.   Str(succ(P^.CurrentRecord), A);
  1074.   If (EntryBox('Record #'+A, P^.RecordData, mfOKCancel,
  1075.     NewSItem(^A'B'^H,  { this is a hidden BYTE field }
  1076.     NewSItem('~      Name~',
  1077.     NewSItem('~    ~\ ssssssssssssssssssssssssssssss'#0'▄  ',
  1078.     NewSItem('~      ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀~',
  1079.     NewSItem('    ~SSN:     ~\ ###-##-#### '#0'▄',
  1080.     NewSItem('~               ▀▀▀▀▀▀▀▀▀▀▀▀▀~',
  1081.     NewSItem('    ~Balance: ~\($rrr,rrr.zz)'#0'▄',
  1082.     NewSItem('~               ▀▀▀▀▀▀▀▀▀▀▀▀▀~',
  1083.     NewSItem('~              Date         Time~',
  1084.     NewSItem('~          ~\' + fldDATETIME,
  1085.     NewSItem('',
  1086.     NewSItem('~    Integer [A]: ~\iii '^R^S#0'~▄ (skip field)~',
  1087.     NewSItem('~    Integer <B>: ~\iii '#0'█',
  1088.     NewSItem('~                   ▀▀▀▀~',
  1089.     NewSItem('~    Pointer: ~\ HHHH:HHHH '#0'▄',
  1090.     NewSItem('~               ▀▀▀▀▀▀▀▀▀▀▀~',
  1091.     NewSItem('~           Value~',
  1092.     NewSItem('~        ~\RRR,RRR.ZZRR ~pts~ '#0'▄',
  1093.     NewSItem('~          ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀~',
  1094.     NewSItem('~        Read-Only: ~\ HH '^R+#0'▄',
  1095.     NewSItem('~                     ▀▀▀▀~',
  1096.          nil)))))))))))))))))))))
  1097.     ) = cmOK)
  1098.     then
  1099.       Message(DeskTop, evBroadcast, cmDMX_DrawData, @BusyData);
  1100. end;
  1101.  
  1102.  
  1103.   { ══════════════════════════════════════════════════════════════════════ }
  1104.  
  1105.  
  1106. procedure InitializeData;
  1107. { creates test data }
  1108. var  i,j  : integer;
  1109.      F      : SearchRec;
  1110.  
  1111.     procedure InitAccount(ARecNum: integer; AName: string);
  1112.     begin
  1113.       With Accounts[ARecNum] do
  1114.     begin
  1115.     Account    := AName;
  1116.     Debit    := Random(50000) * 0.9;
  1117.     Credit    := Random(50000) * 0.9;
  1118.     Status    := (Credit > Debit);
  1119.     end;
  1120.     end;
  1121.  
  1122.     procedure InitBusyRec(ARecNum: integer; AName: string);
  1123.     var  i : integer;
  1124.     begin
  1125.       With BusyData[ARecNum] do
  1126.     begin
  1127.     Name    := AName;
  1128.     intfield0  := ARecNum;
  1129.     hextwo       := lo(ARecNum);
  1130.     If ARecNum < 26 then
  1131.       begin
  1132.       intfield1    := random(255);
  1133.       ptrfield    := pointer(random(MaxInt));
  1134.       realfield1    := random(200) * random(200) / succ(random(199));
  1135.       realfield2    := random(200) * random(200) / succ(random(199));
  1136.       DT.Year    := 1988 + random(4);
  1137.       DT.Month    := succ(random(12));
  1138.       DT.Day    := succ(random(28));
  1139.       DT.Hour    := random(24);
  1140.       DT.Min    := random(60);
  1141.       DT.Sec    := random(60);
  1142.       SSN[0]    := #9;
  1143.       For i := 1 to 9 do SSN[i] := chr(random(10) + 48);
  1144.       end;
  1145.     end;
  1146.     end;
  1147.  
  1148.     procedure InitPayroll(ARecNum: integer; AName: string);
  1149.     begin
  1150.       With Payroll[ARecNum] do
  1151.     begin
  1152.     Employee :=  AName;
  1153.     If (ARecNum = 0) then ID := 44 else ID := Random(400);
  1154.     Earnings :=  Random(3000) + 4000.0;
  1155.     FICA     :=  Earnings * 0.075;
  1156.     FITW     :=  Earnings * 0.28;
  1157.     SITW     :=  Earnings * 0.05;
  1158.     end;
  1159.     end;
  1160.  
  1161. begin
  1162.   RandSeed := 31;
  1163.   fillchar(Accounts,   sizeof(Accounts),   0);
  1164.   fillchar(Payroll,    sizeof(Payroll),       0);
  1165.   fillchar(BusyData,   sizeof(BusyData),   0);
  1166.   fillchar(InvoiceRec, sizeof(InvoiceRec), 0);
  1167.  
  1168.   InitAccount( 0, 'ACME TOOL CO.');
  1169.   InitAccount( 1, 'READING R. R.');
  1170.   InitAccount( 2, 'EXXON CORP.');
  1171.   InitAccount( 3, 'ELECTRIC CO.');
  1172.   InitAccount( 4, 'B&O R. R.');
  1173.   InitAccount( 5, 'NYNEX');
  1174.  
  1175.   InitBusyRec( 0, 'Abigail Adams');
  1176.   InitBusyRec( 1, 'Betty Boop');
  1177.   InitBusyRec( 2, 'Cindy Crawford');
  1178.   InitBusyRec( 3, 'Dana Delaney');
  1179.   InitBusyRec( 4, 'Eve Easton');
  1180.   InitBusyRec( 5, 'Farrah Fawcett');
  1181.   InitBusyRec( 6, 'Ginger Grant');
  1182.   InitBusyRec( 7, 'Holly Hunter');
  1183.   InitBusyRec( 8, 'Ida Inman');
  1184.   InitBusyRec( 9, 'Janet Jackson');
  1185.   InitBusyRec(10, 'Katie Kingfield');
  1186.   InitBusyRec(11, 'Lois Lane');
  1187.   InitBusyRec(12, 'Marilyn Monroe');
  1188.   InitBusyRec(13, 'Nichelle Nichols');
  1189.   InitBusyRec(14, 'Olive Oyl');
  1190.   InitBusyRec(15, 'Paula Prentiss');
  1191.   InitBusyRec(16, 'Quia Quinn');
  1192.   InitBusyRec(17, 'Rita Rudner');
  1193.   InitBusyRec(18, 'Samantha Stevens');
  1194.   InitBusyRec(19, 'Tina Turner');
  1195.   InitBusyRec(20, 'Ursula Upton');
  1196.   InitBusyRec(21, 'Vicky Vail');
  1197.   InitBusyRec(22, 'Wendy Wilson');
  1198.   InitBusyRec(23, 'Xuxa');
  1199.   InitBusyRec(24, 'Yvette Yokomuro');
  1200.   InitBusyRec(25, 'Zelda Zimmerman');
  1201.  
  1202.   For i := 26 to MaxRecordNum do InitBusyRec(i, '');
  1203.   BusyData[0].SSN  := '';
  1204.  
  1205.   InitPayroll( 0, 'Alex Trebek');
  1206.   InitPayroll( 1, 'Pat Sajak');
  1207.   InitPayroll( 2, 'Vanna White');
  1208.   InitPayroll( 3, 'Merv Griffin');
  1209.  
  1210.   InvoiceRec.Quantity := 1;
  1211.   InvoiceRec.Price := UnitPrice;
  1212.   InvoiceRec.Total := UnitPrice;
  1213.  
  1214.   {$IFDEF VER60 }
  1215.   InvoiceRec.TPversion := 6.0;
  1216.   {$ELSE }
  1217.   InvoiceRec.Tools  := InvoiceRec.Tools or TPW;
  1218.   {$ENDIF }
  1219.  
  1220.   {$IFDEF VER70 }
  1221.   InvoiceRec.TPversion := 7.0;
  1222.   {$ENDIF }
  1223.   {$IFDEF VER75 }
  1224.   InvoiceRec.TPversion := 7.5;
  1225.   {$ENDIF }
  1226.   {$IFDEF VER80 }
  1227.   InvoiceRec.TPversion := 8.0;
  1228.   {$ENDIF }
  1229.  
  1230.   FindFirst('\TVDT', Directory, F);
  1231.   If (DosError = 0) then
  1232.     begin
  1233.     InvoiceRec.Tools := InvoiceRec.Tools or Blaise;
  1234.     InvoiceRec.BlaiseProd := 'TVDT';
  1235.     end;
  1236.  
  1237.   FindFirst('\PXENG*.', Directory, F);
  1238.   While (DosError = 0) and (F.Attr and Directory = 0) do FindNext(F);
  1239.   If (DosError = 0) then InvoiceRec.Tools := InvoiceRec.Tools or PXE;
  1240.  
  1241.   FindFirst('\CIM', Directory, F);
  1242.   If (DosError = 0) then
  1243.     InvoiceRec.WhoSaid := CIS
  1244.    else
  1245.     begin
  1246.     FindFirst('\WINCIM', Directory, F);
  1247.     If (DosError = 0) then InvoiceRec.WhoSaid := CIS;
  1248.     end;
  1249.  
  1250. end;
  1251.  
  1252.  
  1253.   { ══════════════════════════════════════════════════════════════════════ }
  1254.  
  1255. var  MyApp  : TMyApp;
  1256.  
  1257. Begin
  1258.   { set default printing options }
  1259.   PrnOpt.Dest     := 0;                    { default output=PRN }
  1260.   PrnOpt.Options := PrnOpt.Options and not repLineNums;    { no line numbers }
  1261.   PrnOpt.Options := PrnOpt.Options or repExtChars;    { extended chars }
  1262.   PrnOpt.Len     :=  55;                { rows per page }
  1263.   PrnOpt.Wid     :=  80;                { maximum page width }
  1264.  
  1265.   MyApp.Init;
  1266.   MyApp.Run;
  1267.   MyApp.Done;
  1268. End.
  1269.